home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / mov2prd.arc / CPP4200.CLP next >
Text File  |  1991-12-04  |  4KB  |  105 lines
  1.  CPP4200:    PGM        PARM(&OBJ &OBJTYPE &TOLIB &OWNER &REPLACE +
  2.                           &RTNAUT)
  3.  
  4.              /*         Move an object to production */
  5.  
  6.              DCL        VAR(&OBJ)     TYPE(*CHAR) LEN(20)
  7.              DCL        VAR(&OBJTYPE) TYPE(*CHAR) LEN(8)
  8.              DCL        VAR(&TOLIB)   TYPE(*CHAR) LEN(10)
  9.              DCL        VAR(&REPLACE) TYPE(*LGL)  LEN(1)
  10.              DCL        VAR(&OWNER)   TYPE(*CHAR) LEN(10)
  11.              DCL        VAR(&RTNAUT)  TYPE(*LGL)  LEN(1)
  12.  
  13.              DCL        &EXISTS *LGL 1 VALUE('0')
  14.              DCL        &TRUE   *LGL 1 VALUE('1')
  15.              DCL        &FALSE  *LGL 1 VALUE('0')
  16.  
  17.              DCL        &MSGDTA  *CHAR 128
  18.              DCL        &MSGF    *CHAR 10
  19.              DCL        &MSGFLIB *CHAR 10
  20.              DCL        &MSGMAX  *DEC  3   VALUE(10) /* Max messages */
  21.              DCL        &MSGCNT  *DEC  3
  22.              DCL        &MSGID   *CHAR 7
  23.              DCL        &MSGMRK  *CHAR 4
  24.              DCL        &MSGTYPE *CHAR 8
  25.              DCL        &MSGRTN  *CHAR 2
  26.  
  27.              MONMSG     MSGID(CPF0000) EXEC(GOTO RCVMSG)
  28.  
  29.              CHKOBJ     OBJ(%SST(&OBJ 1 10).%SST(&OBJ 11 10)) +
  30.                           OBJTYPE(&OBJTYPE)
  31.  
  32.              CHKOBJ     OBJ(&TOLIB) OBJTYPE(*LIB)
  33.  
  34.              CHKOBJ     OBJ(%SST(&OBJ 1 10).&TOLIB) OBJTYPE(&OBJTYPE)
  35.              MONMSG     MSGID(CPF0000) EXEC(GOTO CONTINUE)
  36.  
  37.              IF         (&REPLACE) DO
  38.              CHGVAR     VAR(&EXISTS) VALUE(&TRUE)
  39.              ENDDO
  40.              ELSE       DO
  41.              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Object +
  42.                           already exists in TOLIB and RELPACE(*NO) +
  43.                           was specified.  Change REPLACE to +
  44.                           REPLACE(*YES) or change object name') +
  45.                           MSGTYPE(*DIAG)
  46.              GOTO       RCVMSG
  47.              ENDDO
  48.  
  49.  CONTINUE:   /*  Continue processing */
  50.              IF         (&EXISTS) DO
  51.              CHKOBJ     OBJ(%SST(&OBJ 01 10).QARCHIVE) +
  52.                           OBJTYPE(&OBJTYPE)
  53.              MONMSG     MSGID(CPF0000) EXEC(GOTO MOVE)
  54.  
  55.              DLTOBJ     OBJ(%SST(&OBJ 01 10).QARCHIVE) TYPE(&OBJTYPE)
  56.  
  57.  MOVE:       /*         MOVE THE OBJECT TO THE ARCHIVE LIBRARY */
  58.              MOVOBJ     OBJ(%SST(&OBJ 01 10).&TOLIB) +
  59.                           OBJTYPE(&OBJTYPE) TOLIB(QARCHIVE)
  60.              ENDDO
  61.  
  62.  PUT2PROD:   /*   Put the new object into production */
  63.  
  64.              MOVOBJ    OBJ(%SST(&OBJ 01 10).%SST(&OBJ 11 10)) +
  65.                          OBJTYPE(&OBJTYPE) TOLIB(&TOLIB)
  66.  
  67.              IF         (&OWNER *EQ '*SAME') GOTO GRANT
  68.              CHGOBJOWN  OBJ(%SST(&OBJ 01 10).&TOLIB) +
  69.                           OBJTYPE(&OBJTYPE) NEWOWN(&OWNER)
  70.  GRANT:      /*   Grant object authority */
  71.              IF   (&RTNAUT *AND &EXISTS)    DO
  72.              GRTOBJAUT  OBJ(%SST(&OBJ 01 10).&TOLIB) +
  73.                           OBJTYPE(&OBJTYPE) REFOBJ(%SST(&OBJ 01 +
  74.                           10).QARCHIVE)
  75.              ENDDO
  76.  
  77.  
  78.              GOTO       ENDPGM
  79.  RCVMSG:     /*   Forward error messages to *PRV PGMSGQ   */
  80.              CHGVAR     VAR(&MSGCNT) VALUE(&MSGCNT + 1)
  81.              MONMSG     MSGID(CPF0000 MCH0000) EXEC(GOTO ENDPGM)
  82.              IF         (&MSGCNT *LE &MSGMAX) DO
  83.              RCVMSG     MSGDTA(&MSGDTA) MSGID(&MSGID) +
  84.                          RTNTYPE(&MSGRTN) MSGF(&MSGF) +
  85.                           MSGFLIB(&MSGFLIB)
  86.              IF         (&MSGID *EQ ' ') RETURN
  87.  
  88.              IF         (&MSGRTN *EQ '01') CHGVAR VAR(&MSGTYPE) +
  89.                           VALUE('*COMP')
  90.              IF         (&MSGRTN *EQ '02') CHGVAR VAR(&MSGTYPE) +
  91.                           VALUE('*DIAG')
  92.              IF         (&MSGRTN *EQ '04') CHGVAR VAR(&MSGTYPE) +
  93.                           VALUE('*INFO')
  94.              IF         (&MSGRTN *EQ '14') CHGVAR VAR(&MSGTYPE) +
  95.                           VALUE('*NOTIFY')
  96.              IF         (&MSGRTN *EQ '15') CHGVAR VAR(&MSGTYPE) +
  97.                           VALUE('*ESCAPE')
  98.  
  99.              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGF.&MSGFLIB) +
  100.                           MSGDTA(&MSGDTA) TOPGMQ(*PRV) +
  101.                           MSGTYPE(&MSGTYPE)
  102.              GOTO       RCVMSG
  103.              ENDDO
  104.  ENDPGM:     ENDPGM
  105.